home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / modula.zoo / _defn_ex_process.mod < prev    next >
Text File  |  1988-04-26  |  14KB  |  345 lines
  1. IMPLEMENTATION MODULE Process[7];
  2.  
  3.   FROM SYSTEM IMPORT
  4.     ADDRESS, WORD, BYTE, REG, SETREG, ADR, TSIZE, VAL, INLINE;
  5. (*FROM InOut IMPORT
  6.     WriteString, WriteLn, WriteLongHex, Read;
  7.  *)
  8.  
  9.   CONST
  10.     ModuleBase   = 12;
  11.     ProcessBase  = 13;
  12.     FramPointer  = 14;
  13.     StackPointer = 15;
  14.  
  15.  
  16.   CONST
  17.     InitialStatus    = M68000StatusRegister{sbIntMask0, sbIntMask1};
  18.  (* Special for ATARI: all Processes are running on Interrupt Level 3 *) 
  19.     MinimumStackSize = 256; (* ??? *)
  20.  
  21.   TYPE
  22.     InitialStack =
  23.       RECORD
  24.         Context           : M68000Context;
  25.         SavedReturnPC     : PROC;
  26.       END; (* InitialStack *)
  27.  
  28.   PROCEDURE LISTEN;
  29.   (*
  30.   LISTEN:       move.w  sr,d0
  31.                 trap    #11             * switch to supervisormode
  32.                 move.w  #$0300,sr       * interrupt allowed, usermode
  33.                 nop
  34.                 nop
  35.                 trap    #11
  36.                 move.w  d0,sr           * restore old SR
  37.   *)
  38.   BEGIN
  39.     INLINE( 040C0H,04E4BH,046FCH,00300H,04E71H,04E71H,04E4BH,046C0H );
  40.   END LISTEN;
  41.  
  42.   PROCEDURE CoRoutineEnd();
  43.   BEGIN
  44.     (* This Procedure is never called directly. An illegally terminating
  45.        process will enter this procedure loading a return address from its
  46.        stack, which has been saved there by NEWPROCESS
  47.      *)
  48.     IF MainPROCESSPtr <> NIL THEN
  49.       TRANSFER( ErrorPROCESS, MainPROCESSPtr^ );
  50.     ELSE HALT; END;
  51.   END CoRoutineEnd;
  52.  
  53.  
  54.   PROCEDURE NEWPROCESS (ProcessCode   : PROC;
  55.                         WorkSpaceBase : ADDRESS;
  56.                         WorkSpaceSize : LONGCARD;
  57.                     VAR ProcessDesc   : PROCESS   );
  58.     TYPE
  59.       InitialStackPointer = POINTER TO InitialStack;
  60.       LongIntPtr          = POINTER TO LONGINT;
  61.  
  62.     VAR
  63.       InitialStackPtr : InitialStackPointer;
  64.       WorkSpacePtr,
  65.       WorkSpaceEnd    : LongIntPtr;
  66.       savemask        : CARDINAL;    
  67.  
  68.   BEGIN
  69.     (* Check process workspace *)
  70.     IF ODD( WorkSpaceBase ) THEN HALT; END;
  71.     IF WorkSpaceSize < VAL( LONGCARD, MinimumStackSize ) THEN HALT; END;
  72.     IF ProcessDesc = NIL THEN (* Clear workspace for size and access test *)
  73.       WorkSpacePtr := VAL( LongIntPtr, WorkSpaceBase );
  74.       WorkSpaceEnd := 
  75.         VAL( LongIntPtr, VAL( LONGCARD, WorkSpaceBase ) 
  76.                        + WorkSpaceSize 
  77.                        - VAL( LONGCARD, 3 )            );
  78.       WHILE VAL( LONGCARD, WorkSpacePtr ) < VAL( LONGCARD, WorkSpaceEnd ) DO
  79.         WorkSpacePtr^ := 0;
  80.         INC( VAL( LONGINT, WorkSpacePtr ), 4 );
  81.       END; (* FOR *)
  82.     END; (* IF *) 
  83.     InitialStackPtr := VAL( InitialStackPointer,
  84.                               VAL( LONGCARD, WorkSpaceBase)
  85.                             + WorkSpaceSize 
  86.                             - VAL( LONGCARD, TSIZE(InitialStack)) 
  87.                             );
  88.     WITH InitialStackPtr^ DO
  89.       WITH Context DO
  90.         ModuleBaseA4   := REG(ModuleBase);
  91.         (* ProcessBase auf das obere Ende, (MODEP-Process-Descriptor) *)
  92.         Valid := NIL; (*DS*)
  93.         ProcessBaseA5  := WorkSpaceBase+VAL(ADDRESS,WorkSpaceSize); (*DS*)
  94.         FramePointerA6 := NIL;
  95.         StackPointerA7 := NIL;
  96.         StatusRegister := InitialStatus;
  97.         ProgramCounter := ProcessCode;
  98.       END; (* WITH *)
  99.       SavedReturnPC  := CoRoutineEnd; 
  100.     END; (* WITH *)
  101.     ProcessDesc := VAL( PROCESS, InitialStackPtr );
  102.   END NEWPROCESS;
  103.  
  104.   PROCEDURE InstallTrap();
  105.   (* Calling this Routine installs all Assembler routines *)
  106. (*
  107.  
  108. *
  109. *       - der SUPERVISORMODE ist nicht erlaubt (in MODEB nicht nötig)
  110. *
  111. * dadurch ergibt sich daß TRANSFER,IOTRANSFER nur vom Usermode aufgerufen
  112. * werden. Beim INT muß ein Unterscheidung sttatfinden und beim Übergangen
  113. * S -> U der USP bzw. bei U -> S der SSP gerettet werden. Der letzter Fall
  114. * kommt aber eigentlich nie vor. Sämtliche load's speicheren den zusätzs-
  115. * lichen Stackpointer gegebenenfalls zurück.
  116.        
  117.  
  118. trap3           = $8c                   * TRANSFER
  119. trap4           = $90                   * IOTRANSFER
  120.  
  121. call            = $4eb9
  122. stop_int        = $46fc2700
  123.  
  124. magic           = $04091964
  125.  
  126. INIT:           move.w  sr,d0           * save old mode
  127.                 trap    #11             * Supervisormode
  128.                 lea     TRANSFER-*-2(pc),a0
  129.                 move.l  a0,trap3
  130.                 lea     IOTRANSFER-*-2(pc),a0
  131.                 move.l  a0,trap4
  132.                 move.w  d0,sr           * now old mode again
  133.                 bra     exit
  134.  
  135. *       in Usermode:            
  136. *
  137. *  (A0) USP -> ^To.l   (A1)     
  138. *              ^From.l (A2)     
  139. *              :                
  140. *                               
  141. *       SSP -> Sr.w    (D0)     
  142. *              Pc.l
  143. *              :
  144. * only A4,A5,A6 must be saved !
  145.  
  146. TRANSFER:       move.w  #$2700,sr       * no interrupt allowed
  147.                 move.w  (a7)+,d0        * get SR
  148.  
  149. utrans:         move.l  usp,a0          * get USP
  150.                 move.l  (a0)+,a1        * pointer to "to"
  151.                 move.l  (a0),a2         * pointer to "from", USP now clean
  152.                 move.l  (a7)+,(a0)      * PC, SSP now clean
  153.                 move.w  d0,-(a0)        * SR
  154.                 clr.l   -(a0)           * Stack=NIL
  155.                 movem.l a4-a6,-(a0)     * save important registers
  156.                 lea     -$30(a0),a0     * rest of registers
  157.                 move.l  #magic,-(a0)    * MAGIC setzen
  158.                 move.l  a0,usp          * set new USP
  159.                 move.l  (a1),a6         * load "to"
  160.                 move.l  a0,(a2)         * save "from"
  161.                 btst.b  #5,$44(a6)      * new process in supervisormode ?
  162.                 bne     sload
  163.  
  164. uload:          lea     $4a(a6),a0      * top of context
  165.                 move.l  a0,usp          * set new USP to "to"
  166.                 move.l  $40(a6),d1      * get stack
  167.                 beq     ul_nil          * NIL, don't load
  168.                 move.l  d1,a7           * load SSP
  169. ul_nil:         move.l  -(a0),-(a7)     * PC
  170.                 move.w  -(a0),-(a7)     * SR
  171.                 clr.l   (a6)+           * MAGIC löschen
  172.                 movem.l (a6)+,d0-a5     * restore registers
  173.                 move.l  (a6),a6         * A6
  174.                 rte
  175.  
  176. sload:          move.l  a6,a7           * set new SSP to "to"
  177.                 move.l  $40(a7),d1      * get stack
  178.                 beq     sl_nil          * NIL, don't load
  179.                 move.l  d1,a1
  180.                 move.l  a1,usp          * load USP
  181. sl_nil:         clr.l   (a7)+           * MAGIC löschen
  182.                 movem.l (a7)+,d0-a6     * restore registers
  183.                 tst.l   (a7)+           * discharge stack
  184.                 rte
  185.  
  186.  
  187. *       in Usermode:           
  188. *
  189. *  (A0) USP -> Vector.l (A1)   
  190. *              ^To.l    (A2)   
  191. *              ^From.l  (A3)   
  192. *              :               
  193. *                              
  194. *       SSP -> Sr.w    (D0)    
  195. *              Pc.l
  196. *              :
  197.  
  198. IOTRANSFER:     move.w  #$2700,sr       * no interrupt allowed
  199.                 move.w  (a7)+,d0        * get SR
  200.  
  201. uiotrans:       move.l  usp,a0          * get USP
  202.                 movem.l (a0)+,a1-a3     * clean up USP
  203.                 move.l  (a7)+,-(a0)     * PC, SSP now clean
  204.                 move.w  d0,-(a0)        * SR
  205.                 clr.l   -(a0)           * stack=NIL
  206.                 movem.l a4-a6,-(a0)     * save important registers
  207.                 move.l  a2,-(a0)        * A3: Pointer to "to"
  208.                 lea     -$2c(a0),a0     * rest of registers
  209.                 move.l  #magic,-(a0)    * MAGIC setzen
  210.                 move.l  (a2),a6         * load "to"
  211.                 move.l  a0,(a3)         * save "from"
  212.                 lea     INT-*-2(pc),a2  * interrupt routine
  213.                 move.l  a2,-(a0)        * push
  214.                 move.w  #call,-(a0)     * push JSR opcode
  215.                 move.l  #stop_int,-(a0) * push MOVE.W #$2700,SR opcode
  216.                 move.l  a0,(a1)         * set vector
  217.                 move.l  a0,usp          * set new USP
  218.                 btst.b  #5,$44(a6)      * new proces